home *** CD-ROM | disk | FTP | other *** search
Text File | 1990-06-05 | 57.2 KB | 1,790 lines |
- Newsgroups: comp.sources.misc
- From: daveg@csvax.caltech.edu (David Gillespie)
- Subject: v13i035: Emacs Calculator 1.01, part 09/19
- Sender: allbery@uunet.UU.NET (Brandon S. Allbery - comp.sources.misc)
-
- Posting-number: Volume 13, Issue 35
- Submitted-by: daveg@csvax.caltech.edu (David Gillespie)
- Archive-name: gmcalc/part09
-
- ---- Cut Here and unpack ----
- #!/bin/sh
- # this is part 9 of a multipart archive
- # do not concatenate these parts, unpack them in order with /bin/sh
- # file calc-ext.el continued
- #
- CurArch=9
- if test ! -r s2_seq_.tmp
- then echo "Please unpack part 1 first!"
- exit 1; fi
- ( read Scheck
- if test "$Scheck" != $CurArch
- then echo "Please unpack part $Scheck next!"
- exit 1;
- else exit 0; fi
- ) < s2_seq_.tmp || exit 1
- echo "x - Continuing file calc-ext.el"
- sed 's/^X//' << 'SHAR_EOF' >> calc-ext.el
- X 1153 1163 1171 1181 1187 1193 1201 1213 1217 1223 1229 1231 1237 1249
- X 1259 1277 1279 1283 1289 1291 1297 1301 1303 1307 1319 1321 1327 1361
- X 1367 1373 1381 1399 1409 1423 1427 1429 1433 1439 1447 1451 1453 1459
- X 1471 1481 1483 1487 1489 1493 1499 1511 1523 1531 1543 1549 1553 1559
- X 1567 1571 1579 1583 1597 1601 1607 1609 1613 1619 1621 1627 1637 1657
- X 1663 1667 1669 1693 1697 1699 1709 1721 1723 1733 1741 1747 1753 1759
- X 1777 1783 1787 1789 1801 1811 1823 1831 1847 1861 1867 1871 1873 1877
- X 1879 1889 1901 1907 1913 1931 1933 1949 1951 1973 1979 1987 1993 1997
- X 1999 2003 2011 2017 2027 2029 2039 2053 2063 2069 2081 2083 2087 2089
- X 2099 2111 2113 2129 2131 2137 2141 2143 2153 2161 2179 2203 2207 2213
- X 2221 2237 2239 2243 2251 2267 2269 2273 2281 2287 2293 2297 2309 2311
- X 2333 2339 2341 2347 2351 2357 2371 2377 2381 2383 2389 2393 2399 2411
- X 2417 2423 2437 2441 2447 2459 2467 2473 2477 2503 2521 2531 2539 2543
- X 2549 2551 2557 2579 2591 2593 2609 2617 2621 2633 2647 2657 2659 2663
- X 2671 2677 2683 2687 2689 2693 2699 2707 2711 2713 2719 2729 2731 2741
- X 2749 2753 2767 2777 2789 2791 2797 2801 2803 2819 2833 2837 2843 2851
- X 2857 2861 2879 2887 2897 2903 2909 2917 2927 2939 2953 2957 2963 2969
- X 2971 2999 3001 3011 3019 3023 3037 3041 3049 3061 3067 3079 3083 3089
- X 3109 3119 3121 3137 3163 3167 3169 3181 3187 3191 3203 3209 3217 3221
- X 3229 3251 3253 3257 3259 3271 3299 3301 3307 3313 3319 3323 3329 3331
- X 3343 3347 3359 3361 3371 3373 3389 3391 3407 3413 3433 3449 3457 3461
- X 3463 3467 3469 3491 3499 3511 3517 3527 3529 3533 3539 3541 3547 3557
- X 3559 3571 3581 3583 3593 3607 3613 3617 3623 3631 3637 3643 3659 3671
- X 3673 3677 3691 3697 3701 3709 3719 3727 3733 3739 3761 3767 3769 3779
- X 3793 3797 3803 3821 3823 3833 3847 3851 3853 3863 3877 3881 3889 3907
- X 3911 3917 3919 3923 3929 3931 3943 3947 3967 3989 4001 4003 4007 4013
- X 4019 4021 4027 4049 4051 4057 4073 4079 4091 4093 4099 4111 4127 4129
- X 4133 4139 4153 4157 4159 4177 4201 4211 4217 4219 4229 4231 4241 4243
- X 4253 4259 4261 4271 4273 4283 4289 4297 4327 4337 4339 4349 4357 4363
- X 4373 4391 4397 4409 4421 4423 4441 4447 4451 4457 4463 4481 4483 4493
- X 4507 4513 4517 4519 4523 4547 4549 4561 4567 4583 4591 4597 4603 4621
- X 4637 4639 4643 4649 4651 4657 4663 4673 4679 4691 4703 4721 4723 4729
- X 4733 4751 4759 4783 4787 4789 4793 4799 4801 4813 4817 4831 4861 4871
- X 4877 4889 4903 4909 4919 4931 4933 4937 4943 4951 4957 4967 4969 4973
- X 4987 4993 4999 5003])
- X
- X
- X
- X
- X;;; Bitwise operations.
- X
- X(defun math-and (a b &optional w) ; [I I I] [Public]
- X (cond ((Math-messy-integerp w)
- X (math-and a b (math-trunc w)))
- X ((and w (not (integerp w)))
- X (math-reject-arg w 'integerp))
- X ((and (integerp a) (integerp b))
- X (math-clip (logand a b) w))
- X ((or (eq (car-safe a) 'mod) (eq (car-safe b) 'mod))
- X (math-binary-modulo-args 'math-and a b w))
- X ((not (Math-num-integerp a))
- X (math-reject-arg a 'integerp))
- X ((not (Math-num-integerp b))
- X (math-reject-arg b 'integerp))
- X (t (math-clip (cons 'bigpos
- X (math-and-bignum (math-binary-arg a w)
- X (math-binary-arg b w)))
- X w)))
- X)
- X(fset 'calcFunc-and (symbol-function 'math-and))
- X
- X(defun math-binary-arg (a w)
- X (if (not (Math-integerp a))
- X (setq a (math-trunc a)))
- X (if (Math-integer-negp a)
- X (math-not-bignum (cdr (math-bignum-test (math-sub -1 a)))
- X (math-abs (if w (math-trunc w) calc-word-size)))
- X (cdr (Math-bignum-test a)))
- X)
- X
- X(defun math-binary-modulo-args (f a b w)
- X (let (mod)
- X (if (eq (car-safe a) 'mod)
- X (progn
- X (setq mod (nth 2 a)
- X a (nth 1 a))
- X (if (eq (car-safe b) 'mod)
- X (if (equal mod (nth 2 b))
- X (setq b (nth 1 b))
- X (math-reject-arg b "Inconsistent modulos"))))
- X (setq mod (nth 2 b)
- X b (nth 1 b)))
- X (if (Math-messy-integerp mod)
- X (setq mod (math-trunc mod))
- X (or (Math-integerp mod)
- X (math-reject-arg mod 'integerp)))
- X (let ((bits (math-integer-log2 mod)))
- X (if bits
- X (if w
- X (if (/= w bits)
- X (calc-record-why
- X "Warning: Modulo inconsistent with word size"))
- X (setq w bits))
- X (calc-record-why "Warning: Modulo is not a power of 2"))
- X (math-make-mod (if b
- X (funcall f a b w)
- X (funcall f a w))
- X mod)))
- X)
- X
- X(defun math-and-bignum (a b) ; [l l l]
- X (and a b
- X (let ((qa (math-div-bignum-digit a 512))
- X (qb (math-div-bignum-digit b 512)))
- X (math-mul-bignum-digit (math-and-bignum (math-norm-bignum (car qa))
- X (math-norm-bignum (car qb)))
- X 512
- X (logand (cdr qa) (cdr qb)))))
- X)
- X
- X(defun math-or (a b &optional w) ; [I I I] [Public]
- X (cond ((Math-messy-integerp w)
- X (math-or a b (math-trunc w)))
- X ((and w (not (integerp w)))
- X (math-reject-arg w 'integerp))
- X ((and (integerp a) (integerp b))
- X (math-clip (logior a b) w))
- X ((or (eq (car-safe a) 'mod) (eq (car-safe b) 'mod))
- X (math-binary-modulo-args 'math-or a b w))
- X ((not (Math-num-integerp a))
- X (math-reject-arg a 'integerp))
- X ((not (Math-num-integerp b))
- X (math-reject-arg b 'integerp))
- X (t (math-clip (cons 'bigpos
- X (math-or-bignum (math-binary-arg a w)
- X (math-binary-arg b w)))
- X w)))
- X)
- X(fset 'calcFunc-or (symbol-function 'math-or))
- X
- X(defun math-or-bignum (a b) ; [l l l]
- X (and (or a b)
- X (let ((qa (math-div-bignum-digit a 512))
- X (qb (math-div-bignum-digit b 512)))
- X (math-mul-bignum-digit (math-or-bignum (math-norm-bignum (car qa))
- X (math-norm-bignum (car qb)))
- X 512
- X (logior (cdr qa) (cdr qb)))))
- X)
- X
- X(defun math-xor (a b &optional w) ; [I I I] [Public]
- X (cond ((Math-messy-integerp w)
- X (math-xor a b (math-trunc w)))
- X ((and w (not (integerp w)))
- X (math-reject-arg w 'integerp))
- X ((and (integerp a) (integerp b))
- X (math-clip (logxor a b) w))
- X ((or (eq (car-safe a) 'mod) (eq (car-safe b) 'mod))
- X (math-binary-modulo-args 'math-xor a b w))
- X ((not (Math-num-integerp a))
- X (math-reject-arg a 'integerp))
- X ((not (Math-num-integerp b))
- X (math-reject-arg b 'integerp))
- X (t (math-clip (cons 'bigpos
- X (math-xor-bignum (math-binary-arg a w)
- X (math-binary-arg b w)))
- X w)))
- X)
- X(fset 'calcFunc-xor (symbol-function 'math-xor))
- X
- X(defun math-xor-bignum (a b) ; [l l l]
- X (and (or a b)
- X (let ((qa (math-div-bignum-digit a 512))
- X (qb (math-div-bignum-digit b 512)))
- X (math-mul-bignum-digit (math-xor-bignum (math-norm-bignum (car qa))
- X (math-norm-bignum (car qb)))
- X 512
- X (logxor (cdr qa) (cdr qb)))))
- X)
- X
- X(defun math-diff (a b &optional w) ; [I I I] [Public]
- X (cond ((Math-messy-integerp w)
- X (math-diff a b (math-trunc w)))
- X ((and w (not (integerp w)))
- X (math-reject-arg w 'integerp))
- X ((and (integerp a) (integerp b))
- X (math-clip (logand a (lognot b)) w))
- X ((or (eq (car-safe a) 'mod) (eq (car-safe b) 'mod))
- X (math-binary-modulo-args 'math-diff a b w))
- X ((not (Math-num-integerp a))
- X (math-reject-arg a 'integerp))
- X ((not (Math-num-integerp b))
- X (math-reject-arg b 'integerp))
- X (t (math-clip (cons 'bigpos
- X (math-diff-bignum (math-binary-arg a w)
- X (math-binary-arg b w)))
- X w)))
- X)
- X(fset 'calcFunc-diff (symbol-function 'math-diff))
- X
- X(defun math-diff-bignum (a b) ; [l l l]
- X (and a
- X (let ((qa (math-div-bignum-digit a 512))
- X (qb (math-div-bignum-digit b 512)))
- X (math-mul-bignum-digit (math-diff-bignum (math-norm-bignum (car qa))
- X (math-norm-bignum (car qb)))
- X 512
- X (logand (cdr qa) (lognot (cdr qb))))))
- X)
- X
- X(defun math-not (a &optional w) ; [I I] [Public]
- X (cond ((Math-messy-integerp w)
- X (math-not a (math-trunc w)))
- X ((eq (car-safe a) 'mod)
- X (math-binary-modulo-args 'math-not a nil w))
- X ((and w (not (integerp w)))
- X (math-reject-arg w 'integerp))
- X ((not (Math-num-integerp a))
- X (math-reject-arg a 'integerp))
- X ((< (or w (setq w calc-word-size)) 0)
- X (math-clip (math-not a (- w)) w))
- X (t (math-normalize
- X (cons 'bigpos
- X (math-not-bignum (math-binary-arg a w)
- X w)))))
- X)
- X(fset 'calcFunc-not (symbol-function 'math-not))
- X
- X(defun math-not-bignum (a w) ; [l l]
- X (let ((q (math-div-bignum-digit a 512)))
- X (if (<= w 9)
- X (list (logand (lognot (cdr q))
- X (1- (lsh 1 w))))
- X (math-mul-bignum-digit (math-not-bignum (math-norm-bignum (car q))
- X (- w 9))
- X 512
- X (logxor (cdr q) 511))))
- X)
- X
- X(defun math-lshift-binary (a &optional n w) ; [I I] [Public]
- X (setq a (math-trunc a)
- X n (if n (math-trunc n) 1))
- X (if (eq (car-safe a) 'mod)
- X (math-binary-modulo-args 'math-lshift-binary a n w)
- X (setq w (if w (math-trunc w) calc-word-size))
- X (or (integerp w)
- X (math-reject-arg w 'integerp))
- X (or (Math-integerp a)
- X (math-reject-arg a 'integerp))
- X (or (Math-integerp n)
- X (math-reject-arg n 'integerp))
- X (if (< w 0)
- X (math-clip (math-lshift-binary a n (- w)) w)
- X (if (Math-integer-negp a)
- X (setq a (math-clip a w)))
- X (cond ((or (Math-lessp n (- w))
- X (Math-lessp w n))
- X 0)
- X ((< n 0)
- X (math-quotient (math-clip a w) (math-power-of-2 (- n))))
- X (t
- X (math-clip (math-mul a (math-power-of-2 n)) w)))))
- X)
- X(fset 'calcFunc-lsh (symbol-function 'math-lshift-binary))
- X
- X(defun math-rshift-binary (a &optional n w) ; [I I] [Public]
- X (math-lshift-binary a (math-neg (or n 1)) w)
- X)
- X(fset 'calcFunc-rsh (symbol-function 'math-rshift-binary))
- X
- X(defun math-shift-binary (a &optional n w) ; [I I] [Public]
- X (if (not (Math-negp n))
- X (math-lshift-binary a n w)
- X (setq a (math-trunc a)
- X n (if n (math-trunc n) 1))
- X (if (eq (car-safe a) 'mod)
- X (math-binary-modulo-args 'math-shift-binary a n w)
- X (setq w (if w (math-trunc w) calc-word-size))
- X (or (integerp w)
- X (math-reject-arg w 'integerp))
- X (or (Math-integerp a)
- X (math-reject-arg a 'integerp))
- X (or (Math-integerp n)
- X (math-reject-arg n 'integerp))
- X (if (< w 0)
- X (math-clip (math-shift-binary a n (- w)) w)
- X (if (Math-integer-negp a)
- X (setq a (math-clip a w)))
- X (let ((two-to-sizem1 (math-power-of-2 (1- w)))
- X (sh (math-lshift-binary a n w)))
- X (cond ((Math-natnum-lessp a two-to-sizem1)
- X sh)
- X ((Math-lessp n (- 1 w))
- X (math-add (math-mul two-to-sizem1 2) -1))
- X (t (let ((two-to-n (math-power-of-2 (- n))))
- X (math-add (math-lshift-binary (math-add two-to-n -1)
- X (+ w n) w)
- X sh))))))))
- X)
- X(fset 'calcFunc-ash (symbol-function 'math-shift-binary))
- X
- X(defun math-rotate-binary (a &optional n w) ; [I I] [Public]
- X (setq a (math-trunc a)
- X n (if n (math-trunc n) 1))
- X (if (eq (car-safe a) 'mod)
- X (math-binary-modulo-args 'math-rotate-binary a n w)
- X (setq w (if w (math-trunc w) calc-word-size))
- X (or (integerp w)
- X (math-reject-arg w 'integerp))
- X (or (Math-integerp a)
- X (math-reject-arg a 'integerp))
- X (or (Math-integerp n)
- X (math-reject-arg n 'integerp))
- X (if (< w 0)
- X (math-clip (math-rotate-binary a n (- w)) w)
- X (if (Math-integer-negp a)
- X (setq a (math-clip a w)))
- X (cond ((or (Math-integer-negp n)
- X (not (Math-natnum-lessp n w)))
- X (math-rotate-binary a (math-mod n w) w))
- X (t
- X (math-add (math-lshift-binary a (- n w) w)
- X (math-lshift-binary a n w))))))
- X)
- X(fset 'calcFunc-rot (symbol-function 'math-rotate-binary))
- X
- X(defun math-clip (a &optional w) ; [I I] [Public]
- X (cond ((Math-messy-integerp w)
- X (math-clip a (math-trunc w)))
- X ((eq (car-safe a) 'mod)
- X (math-binary-modulo-args 'math-clip a nil w))
- X ((and w (not (integerp w)))
- X (math-reject-arg w 'integerp))
- X ((not (Math-num-integerp a))
- X (math-reject-arg a 'integerp))
- X ((< (or w (setq w calc-word-size)) 0)
- X (setq a (math-clip a (- w)))
- X (if (Math-natnum-lessp a (math-power-of-2 (- -1 w)))
- X a
- X (math-sub a (math-power-of-2 (- w)))))
- X ((Math-negp a)
- X (math-normalize (cons 'bigpos (math-binary-arg a w))))
- X ((and (integerp a) (< a 1000000))
- X (if (>= w 20)
- X a
- X (logand a (1- (lsh 1 w)))))
- X (t
- X (math-normalize
- X (cons 'bigpos
- X (math-clip-bignum (cdr (math-bignum-test (math-trunc a)))
- X w)))))
- X)
- X(fset 'calcFunc-clip (symbol-function 'math-clip))
- X
- X(defun math-clip-bignum (a w) ; [l l]
- X (let ((q (math-div-bignum-digit a 512)))
- X (if (<= w 9)
- X (list (logand (cdr q)
- X (1- (lsh 1 w))))
- X (math-mul-bignum-digit (math-clip-bignum (math-norm-bignum (car q))
- X (- w 9))
- X 512
- X (cdr q))))
- X)
- X
- X
- X
- X;;;; Algebra.
- X
- X;;; Evaluate variables in an expression.
- X(defun math-evaluate-expr (x) ; [Public]
- X (math-normalize (math-evaluate-expr-rec x))
- X)
- X
- X(defun math-evaluate-expr-rec (x)
- X (if (consp x)
- X (setq x (cons (car x)
- X (mapcar 'math-evaluate-expr-rec (cdr x)))))
- X (if (eq (car-safe x) 'var)
- X (if (and (boundp (nth 2 x))
- X (symbol-value (nth 2 x))
- X (not (eq (car-safe (symbol-value (nth 2 x)))
- X 'incomplete)))
- X (let ((val (symbol-value (nth 2 x))))
- X (if (eq (car-safe val) 'special-const)
- X (if calc-symbolic-mode
- X x
- X val)
- X val))
- X x)
- X x)
- X)
- X
- X
- X;;; Combine two terms being added, if possible.
- X(defun math-combine-sum (a b nega negb scalar-okay)
- X (if (and scalar-okay (Math-objvecp a) (Math-objvecp b))
- X (math-add-or-sub a b nega negb)
- X (let ((amult 1) (bmult 1))
- X (and (consp a)
- X (cond ((and (eq (car a) '*)
- X (Math-numberp (nth 1 a)))
- X (setq amult (nth 1 a)
- X a (nth 2 a)))
- X ((and (eq (car a) '/)
- X (Math-numberp (nth 2 a)))
- X (setq amult (if (Math-integerp (nth 2 a))
- X (list 'frac 1 (nth 2 a))
- X (math-div 1 (nth 2 a)))
- X a (nth 1 a)))
- X ((eq (car a) 'neg)
- X (setq amult -1
- X a (nth 1 a)))))
- X (and (consp b)
- X (cond ((and (eq (car b) '*)
- X (Math-numberp (nth 1 b)))
- X (setq bmult (nth 1 b)
- X b (nth 2 b)))
- X ((and (eq (car b) '/)
- X (Math-numberp (nth 2 b)))
- X (setq bmult (if (Math-integerp (nth 2 b))
- X (list 'frac 1 (nth 2 b))
- X (math-div 1 (nth 2 b)))
- X b (nth 1 b)))
- X ((eq (car b) 'neg)
- X (setq bmult -1
- X b (nth 1 b)))))
- X (and (equal a b)
- X (progn
- X (if nega (setq amult (math-neg amult)))
- X (if negb (setq bmult (math-neg bmult)))
- X (setq amult (math-add amult bmult))
- X (math-mul amult a)))))
- X)
- X
- X(defun math-add-or-sub (a b aneg bneg)
- X (if aneg (setq a (math-neg a)))
- X (if bneg (setq b (math-neg b)))
- X (math-add a b)
- X)
- X
- X;;; The following is expanded out four ways for speed.
- X(defun math-combine-prod (a b inva invb scalar-okay)
- X (cond
- X ((and scalar-okay (Math-objvecp a) (Math-objvecp b))
- X (math-mul-or-div a b inva invb))
- X ((and (eq (car-safe a) '^)
- X inva
- X (math-looks-negp (nth 2 a)))
- X (math-mul (math-pow (nth 1 a) (math-neg (nth 2 a))) b))
- X ((and (eq (car-safe b) '^)
- X invb
- X (math-looks-negp (nth 2 b)))
- X (math-mul a (math-pow (nth 1 b) (math-neg (nth 2 b)))))
- X (t (let ((apow 1) (bpow 1))
- X (and (consp a)
- X (cond ((and (eq (car a) '^)
- X (or math-simplify-symbolic-powers
- X (Math-numberp (nth 2 a))))
- X (setq apow (nth 2 a)
- X a (nth 1 a)))
- X ((and (eq (car a) 'calcFunc-sqrt))
- X (setq apow '(frac 1 2)
- X a (nth 1 a)))))
- X (and (consp b)
- X (cond ((and (eq (car b) '^)
- X (or math-simplify-symbolic-powers
- X (Math-numberp (nth 2 b))))
- X (setq bpow (nth 2 b)
- X b (nth 1 b)))
- X ((and (eq (car b) 'calcFunc-sqrt))
- X (setq bpow '(frac 1 2)
- X b (nth 1 b)))))
- X (and (equal a b)
- X (progn
- X (if inva (setq apow (math-neg apow)))
- X (if invb (setq bpow (math-neg bpow)))
- X (setq apow (math-add apow bpow))
- X (cond ((equal apow '(frac 1 2))
- X (list 'calcFunc-sqrt a))
- X ((equal apow '(frac -1 2))
- X (math-div 1 (list 'calcFunc-sqrt a)))
- X (t (math-pow a apow))))))))
- X)
- X(setq math-simplify-symbolic-powers nil)
- X
- X(defun math-mul-or-div (a b ainv binv)
- X (if ainv
- X (if binv
- X (math-div (math-div 1 a) b)
- X (math-div b a))
- X (if binv
- X (math-div a b)
- X (math-mul a b)))
- X)
- X
- X
- X
- X;;; True if A comes before B in a canonical ordering of expressions. [P X X]
- X(defun math-beforep (a b) ; [Public]
- X (cond ((and (Math-realp a) (Math-realp b))
- X (let ((comp (math-compare a b)))
- X (or (eq comp -1)
- X (and (eq comp 0)
- X (not (equal a b))
- X (> (length (memq (car-safe a)
- X '(bigneg nil bigpos frac float)))
- X (length (memq (car-safe b)
- X '(bigneg nil bigpos frac float))))))))
- X ((Math-realp a) t)
- X ((Math-realp b) nil)
- X ((eq (car a) 'var)
- X (if (eq (car b) 'var)
- X (string-lessp (symbol-name (nth 1 a)) (symbol-name (nth 1 b)))
- X (not (Math-numberp b))))
- X ((eq (car b) 'var) (Math-numberp a))
- X ((eq (car a) (car b))
- X (while (and (setq a (cdr a) b (cdr b)) a
- X (equal (car a) (car b))))
- X (and b
- X (or (null a)
- X (math-beforep (car a) (car b)))))
- X (t (string-lessp (symbol-name (car a)) (symbol-name (car b)))))
- X)
- X
- X
- X
- X(setq math-living-dangerously nil) ; true if unsafe simplifications are okay.
- X
- X(defun math-simplify-extended (a)
- X (let ((math-living-dangerously t))
- X (math-simplify a))
- X)
- X
- X(defun math-simplify (top-expr)
- X (calc-with-default-simplification
- X (let ((math-simplify-symbolic-powers t)
- X res)
- X (while (not (equal top-expr (setq res (math-simplify-step
- X (math-normalize top-expr)))))
- X (setq top-expr res))))
- X top-expr
- X)
- X
- X;;; The following has a "bug" in that if any recursive simplifications
- X;;; occur only the first handler will be tried; this doesn't really
- X;;; matter, since math-simplify-step is iterated to a fixed point anyway.
- X(defun math-simplify-step (a)
- X (if (Math-primp a)
- X a
- X (let ((aa (cons (car a) (mapcar 'math-simplify-step (cdr a)))))
- X (and (symbolp (car aa))
- X (let ((handler (get (car aa) 'math-simplify)))
- X (and handler
- X (progn
- X (while (and handler
- X (equal (setq aa (or (funcall (car handler) aa)
- X aa))
- X a))
- X (setq handler (cdr handler)))
- X res))))
- X aa))
- X)
- X
- X(defmacro math-defsimplify (funcs &rest code)
- X "Define a simplification rule for the specified function.
- XIf FUNCS is a list of functions, the same rule is applied for each function.
- XCODE is a body of Lisp code that returns a simpler form of EXPR.
- XMore than one definition may be made per function. All definitions are tried
- Xin the order they were encountered; the first non-NIL value which is different
- Xfrom the original expression returned is used. The argument EXPR may be
- Xdestructively modified."
- X (append '(progn)
- X (mapcar (function
- X (lambda (func)
- X (list 'put (list 'quote func) ''math-simplify
- X (list 'nconc
- X (list 'get (list 'quote func) ''math-simplify)
- X (list 'list
- X (list 'function
- X (append '(lambda (expr))
- X code)))))))
- X (if (symbolp funcs) (list funcs) funcs)))
- X)
- X(put 'math-defsimplify 'lisp-indent-hook 1)
- X
- X(math-defsimplify (+ -)
- X (math-simplify-plus))
- X
- X(defun math-simplify-plus ()
- X (cond ((and (memq (car-safe (nth 1 expr)) '(+ -))
- X (Math-numberp (nth 2 (nth 1 expr)))
- X (not (Math-numberp (nth 2 expr))))
- X (let ((x (nth 2 expr))
- X (op (car expr)))
- X (setcar (cdr (cdr expr)) (nth 2 (nth 1 expr)))
- X (setcar expr (car (nth 1 expr)))
- X (setcar (cdr (cdr (nth 1 expr))) x)
- X (setcar (nth 1 expr) op)))
- X ((and (eq (car expr) '+)
- X (Math-numberp (nth 1 expr))
- X (not (Math-numberp (nth 2 expr))))
- X (let ((x (nth 2 expr)))
- X (setcar (cdr (cdr expr)) (nth 1 expr))
- X (setcar (cdr expr) x))))
- X (let ((aa expr)
- X aaa temp)
- X (while (memq (car-safe (setq aaa (nth 1 aa))) '(+ -))
- X (if (setq temp (math-combine-sum (nth 2 aaa) (nth 2 expr)
- X (eq (car aaa) '-) (eq (car expr) '-) t))
- X (progn
- X (setcar (cdr (cdr expr)) temp)
- X (setcar expr '+)
- X (setcar (cdr (cdr aaa)) 0)))
- X (setq aa (nth 1 aa)))
- X (if (setq temp (math-combine-sum aaa (nth 2 expr)
- X nil (eq (car expr) '-) t))
- X (progn
- X (setcar (cdr (cdr expr)) temp)
- X (setcar expr '+)
- X (setcar (cdr aa) 0)))
- X expr)
- X)
- X
- X(math-defsimplify *
- X (math-simplify-times))
- X
- X(defun math-simplify-times ()
- X (if (eq (car-safe (nth 2 expr)) '*)
- X (and (math-beforep (nth 1 (nth 2 expr)) (nth 1 expr))
- X (let ((x (nth 1 expr)))
- X (setcar (cdr expr) (nth 1 (nth 2 expr)))
- X (setcar (cdr (nth 2 expr)) x)))
- X (and (math-beforep (nth 2 expr) (nth 1 expr))
- X (let ((x (nth 2 expr)))
- X (setcar (cdr (cdr expr)) (nth 1 expr))
- X (setcar (cdr expr) x))))
- X (let ((aa expr)
- X aaa temp)
- X (while (eq (car-safe (setq aaa (nth 2 aa))) '*)
- X (if (setq temp (math-combine-prod (nth 1 expr) (nth 1 aaa) nil nil t))
- X (progn
- X (setcar (cdr expr) temp)
- X (setcar (cdr aaa) 1)))
- X (setq aa (nth 2 aa)))
- X (if (setq temp (math-combine-prod aaa (nth 1 expr) nil nil t))
- X (progn
- X (setcar (cdr expr) temp)
- X (setcar (cdr (cdr aa)) 1)))
- X expr)
- X)
- X
- X(math-defsimplify /
- X (math-simplify-divide))
- X
- X(defun math-simplify-divide ()
- X (let ((np (cdr expr))
- X n nn)
- X (setq nn (math-common-constant-factor (nth 2 expr)))
- X (if nn
- X (progn
- X (setq n (math-common-constant-factor (nth 1 expr)))
- X (if (and (consp nn) (eq (nth 1 nn) 1) (not n))
- X (progn
- X (setcar (cdr expr) (math-mul (nth 1 expr) nn))
- X (setcar (cdr (cdr expr))
- X (math-cancel-common-factor (nth 2 expr) nn)))
- X (if (and n (not (eq (setq n (math-frac-gcd n nn)) 1)))
- X (progn
- X (setcar (cdr expr)
- X (math-cancel-common-factor (nth 1 expr) n))
- X (setcar (cdr (cdr expr))
- X (math-cancel-common-factor (nth 2 expr) n)))))))
- X (while (eq (car-safe (setq n (car np))) '*)
- X (math-simplify-divisor (cdr n) (cdr (cdr expr)))
- X (setq np (cdr (cdr n))))
- X (math-simplify-divisor np (cdr (cdr expr)))
- X expr)
- X)
- X
- X(defun math-simplify-divisor (np dp)
- X (let ((n (car np))
- X d dd temp)
- X (while (eq (car-safe (setq d (car dp))) '*)
- X (if (setq temp (math-combine-prod n (nth 1 d) nil t t))
- X (progn
- X (setcar np (setq n temp))
- X (setcar (cdr d) 1)))
- X (setq dp (cdr (cdr d))))
- X (if (setq temp (math-combine-prod n d nil t t))
- X (progn
- X (setcar np (setq n temp))
- X (setcar dp 1))))
- X)
- X
- X(defun math-common-constant-factor (expr)
- X (if (Math-primp expr)
- X (if (Math-ratp expr)
- X (and (not (memq expr '(0 1)))
- X (math-abs expr))
- X (if (Math-ratp (setq expr (math-to-simple-fraction expr)))
- X (math-common-constant-factor expr)))
- X (if (memq (car expr) '(+ -))
- X (let ((f1 (math-common-constant-factor (nth 1 expr)))
- X (f2 (math-common-constant-factor (nth 2 expr))))
- X (and f1 f2
- X (not (eq (setq f1 (math-frac-gcd f1 f2)) 1))
- X f1))
- X (if (memq (car expr) '(* /))
- X (math-common-constant-factor (nth 1 expr)))))
- X)
- X
- X(defun math-cancel-common-factor (expr val)
- X (if (memq (car-safe expr) '(+ -))
- X (progn
- X (setcar (cdr expr) (math-cancel-common-factor (nth 1 expr) val))
- X (setcar (cdr (cdr expr)) (math-cancel-common-factor (nth 2 expr) val))
- X expr)
- X (math-div expr val))
- X)
- X
- X(defun math-frac-gcd (a b)
- X (if (and (Math-integerp a)
- X (Math-integerp b))
- X (math-gcd a b)
- X (or (Math-integerp a) (setq a (list 'frac a 1)))
- X (or (Math-integerp b) (setq b (list 'frac b 1)))
- X (math-make-frac (math-gcd (nth 1 a) (nth 1 b))
- X (math-gcd (nth 2 a) (nth 2 b))))
- X)
- X
- X(math-defsimplify calcFunc-sin
- X (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsin)
- X (nth 1 (nth 1 expr)))
- X (and (math-looks-negp (nth 1 expr))
- X (math-neg (list 'calcFunc-sin (math-neg (nth 1 expr)))))
- X (and math-living-dangerously
- X (eq (car-safe (nth 1 expr)) 'calcFunc-arccos)
- X (list 'calcFunc-sqrt (math-sub 1 (math-sqr (nth 1 (nth 1 expr))))))
- X (and math-living-dangerously
- X (eq (car-safe (nth 1 expr)) 'calcFunc-arctan)
- X (math-div (nth 1 (nth 1 expr))
- X (list 'calcFunc-sqrt
- X (math-add 1 (math-sqr (nth 1 (nth 1 expr))))))))
- X)
- X
- X(math-defsimplify calcFunc-cos
- X (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccos)
- X (nth 1 (nth 1 expr)))
- X (and (math-looks-negp (nth 1 expr))
- X (list 'calcFunc-cos (math-neg (nth 1 expr))))
- X (and math-living-dangerously
- X (eq (car-safe (nth 1 expr)) 'calcFunc-arcsin)
- X (list 'calcFunc-sqrt (math-sub 1 (math-sqr (nth 1 (nth 1 expr))))))
- X (and math-living-dangerously
- X (eq (car-safe (nth 1 expr)) 'calcFunc-arctan)
- X (math-div 1
- X (list 'calcFunc-sqrt
- X (math-add 1 (math-sqr (nth 1 (nth 1 expr))))))))
- X)
- X
- X(math-defsimplify calcFunc-tan
- X (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctan)
- X (nth 1 (nth 1 expr)))
- X (and (math-looks-negp (nth 1 expr))
- X (math-neg (list 'calcFunc-tan (math-neg (nth 1 expr)))))
- X (and math-living-dangerously
- X (eq (car-safe (nth 1 expr)) 'calcFunc-arcsin)
- X (math-div (nth 1 (nth 1 expr))
- X (list 'calcFunc-sqrt
- X (math-sub 1 (math-sqr (nth 1 (nth 1 expr)))))))
- X (and math-living-dangerously
- X (eq (car-safe (nth 1 expr)) 'calcFunc-arccos)
- X (math-div (list 'calcFunc-sqrt
- X (math-sub 1 (math-sqr (nth 1 (nth 1 expr)))))
- X (nth 1 (nth 1 expr)))))
- X)
- X
- X(math-defsimplify calcFunc-sinh
- X (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsinh)
- X (nth 1 (nth 1 expr)))
- X)
- X
- X(math-defsimplify calcFunc-cosh
- X (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccosh)
- X (nth 1 (nth 1 expr)))
- X)
- X
- X(math-defsimplify calcFunc-tanh
- X (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctanh)
- X (nth 1 (nth 1 expr)))
- X)
- X
- X(math-defsimplify calcFunc-arcsin
- X (or (and (math-looks-negp (nth 1 expr))
- X (math-neg (list 'calcFunc-arcsin (math-neg (nth 1 expr)))))
- X (and math-living-dangerously
- X (eq (car-safe (nth 1 expr)) 'calcFunc-sin)
- X (nth 1 (nth 1 expr)))
- X (and math-living-dangerously
- X (eq (car-safe (nth 1 expr)) 'calcFunc-cos)
- X (math-sub (math-div '(var pi var-pi) 2)
- X (nth 1 (nth 1 expr)))))
- X)
- X
- X(math-defsimplify calcFunc-arccos
- X (or (and math-living-dangerously
- X (eq (car-safe (nth 1 expr)) 'calcFunc-cos)
- X (nth 1 (nth 1 expr)))
- X (and math-living-dangerously
- X (eq (car-safe (nth 1 expr)) 'calcFunc-sin)
- X (math-sub (math-div '(var pi var-pi) 2)
- X (nth 1 (nth 1 expr)))))
- X)
- X
- X(math-defsimplify calcFunc-arctan
- X (or (and (math-looks-negp (nth 1 expr))
- X (math-neg (list 'calcFunc-arctan (math-neg (nth 1 expr)))))
- X (and math-living-dangerously
- X (eq (car-safe (nth 1 expr)) 'calcFunc-tan)
- X (nth 1 (nth 1 expr))))
- X)
- X
- X(math-defsimplify calcFunc-arcsinh
- X (and math-living-dangerously
- X (eq (car-safe (nth 1 expr)) 'calcFunc-sinh)
- X (nth 1 (nth 1 expr)))
- X)
- X
- X(math-defsimplify calcFunc-arccosh
- X (and math-living-dangerously
- X (eq (car-safe (nth 1 expr)) 'calcFunc-cosh)
- X (nth 1 (nth 1 expr)))
- X)
- X
- X(math-defsimplify calcFunc-arctanh
- X (and math-living-dangerously
- X (eq (car-safe (nth 1 expr)) 'calcFunc-tanh)
- X (nth 1 (nth 1 expr)))
- X)
- X
- X(math-defsimplify calcFunc-sqrt
- X (or (let ((fac (math-common-constant-factor (nth 1 expr))))
- X (and fac
- X (math-mul (list 'calcFunc-sqrt fac)
- X (list 'calcFunc-sqrt
- X (math-cancel-common-factor (nth 1 expr) fac)))))
- X (and (eq (car-safe (nth 1 expr)) '-)
- X (math-equal-int (nth 1 (nth 1 expr)) 1)
- X (eq (car-safe (nth 2 (nth 1 expr))) '^)
- X (math-equal-int (nth 2 (nth 2 (nth 1 expr))) 2)
- X (or (and (eq (car-safe (nth 1 (nth 2 (nth 1 expr)))) 'calcFunc-sin)
- X (list 'calcFunc-cos
- X (nth 1 (nth 1 (nth 2 (nth 1 expr))))))
- X (and (eq (car-safe (nth 1 (nth 2 (nth 1 expr)))) 'calcFunc-cos)
- X (list 'calcFunc-sin
- X (nth 1 (nth 1 (nth 2 (nth 1 expr))))))))
- X (and math-living-dangerously
- X (or (and (eq (car-safe (nth 1 expr)) '^)
- X (list '^
- X (nth 1 (nth 1 expr))
- X (math-div (nth 2 (nth 1 expr)) 2)))
- X (and (eq (car-safe (nth 1 expr)) 'calcFunc-sqrt)
- X (list '^ (nth 1 (nth 1 expr)) (math-div 1 4))))))
- X)
- X
- X(math-defsimplify 'calcFunc-exp
- X (and (eq (car-safe (nth 1 expr)) 'calcFunc-ln)
- X (nth 1 (nth 1 expr)))
- X)
- X
- X(math-defsimplify 'calcFunc-ln
- X (and math-living-dangerously
- X (eq (car-safe (nth 1 expr)) 'calcFunc-exp)
- X (nth 1 (nth 1 expr)))
- X)
- X
- X(math-defsimplify '^
- X (math-simplify-pow))
- X
- X(defun math-simplify-pow ()
- X (or (and math-living-dangerously
- X (or (and (eq (car-safe (nth 1 expr)) '^)
- X (list '^
- X (nth 1 (nth 1 expr))
- X (math-mul (nth 2 expr) (nth 2 (nth 1 expr)))))
- X (and (eq (car-safe (nth 1 expr)) 'calcFunc-sqrt)
- X (list '^
- X (nth 1 (nth 1 expr))
- X (math-div (nth 2 expr) 2)))))
- X (and (math-equal-int (nth 1 expr) 10)
- X (eq (car-safe (nth 2 expr)) 'calcFunc-log10)
- X (nth 1 (nth 2 expr)))
- X (and (equal (nth 1 expr) '(var e var-e))
- X (eq (car-safe (nth 2 expr)) 'calcFunc-ln)
- X (nth 1 (nth 2 expr))))
- X)
- X
- X(math-defsimplify 'calcFunc-log10
- X (and math-living-dangerously
- X (eq (car-safe (nth 1 expr)) '^)
- X (math-equal-int (nth 1 (nth 1 expr)) 10)
- X (nth 2 (nth 1 expr)))
- X)
- X
- X
- X
- X
- X(defun math-expand-term (expr)
- X (cond ((and (eq (car-safe expr) '*)
- X (memq (car-safe (nth 1 expr)) '(+ -)))
- X (math-add-or-sub (math-mul (nth 1 (nth 1 expr)) (nth 2 expr))
- X (math-mul (nth 2 (nth 1 expr)) (nth 2 expr))
- X nil (eq (car (nth 1 expr)) '-)))
- X ((and (eq (car-safe expr) '*)
- X (memq (car-safe (nth 2 expr)) '(+ -)))
- X (math-add-or-sub (math-mul (nth 1 expr) (nth 1 (nth 2 expr)))
- X (math-mul (nth 1 expr) (nth 2 (nth 2 expr)))
- X nil (eq (car (nth 2 expr)) '-)))
- X ((and (eq (car-safe expr) '/)
- X (memq (car-safe (nth 1 expr)) '(+ -)))
- X (math-add-or-sub (math-div (nth 1 (nth 1 expr)) (nth 2 expr))
- X (math-div (nth 2 (nth 1 expr)) (nth 2 expr))
- X nil (eq (car (nth 1 expr)) '-)))
- X ((and (eq (car-safe expr) '^)
- X (memq (car-safe (nth 1 expr)) '(+ -))
- X (integerp (nth 2 expr))
- X (if (> (nth 2 expr) 0)
- X (list '*
- X (nth 1 expr)
- X (math-pow (nth 1 expr) (1- (nth 2 expr))))
- X (if (< (nth 2 expr) 0)
- X (math-div 1 (math-pow (nth 1 expr)
- X (- (nth 2 expr))))))))
- X (t expr))
- X)
- X
- X(defun math-expand-tree (expr &optional many)
- X (math-map-tree 'math-expand-term expr many)
- X)
- X
- X(defun math-map-tree (mmt-func mmt-expr &optional mmt-many)
- X (or mmt-many (setq mmt-many 1000000))
- X (math-map-tree-rec mmt-expr)
- X)
- X
- X(defun math-map-tree-rec (mmt-expr)
- X (or (= mmt-many 0)
- X (let ((mmt-done nil)
- X mmt-nextval)
- X (while (not mmt-done)
- X (while (and (/= mmt-many 0)
- X (setq mmt-nextval (funcall mmt-func mmt-expr))
- X (not (equal mmt-expr mmt-nextval)))
- X (setq mmt-expr mmt-nextval
- X mmt-many (if (> mmt-many 0) (1- mmt-many) (1+ mmt-many))))
- X (if (or (Math-primp mmt-expr)
- X (<= mmt-many 0))
- X (setq mmt-done t)
- X (setq mmt-nextval (cons (car mmt-expr)
- X (mapcar 'math-map-tree-rec (cdr mmt-expr))))
- X (if (equal mmt-nextval mmt-expr)
- X (setq mmt-done t)
- X (setq mmt-expr mmt-nextval))))))
- X mmt-expr
- X)
- X
- X
- X
- X
- X(defun math-apply-rewrite (expr lhs rhs &optional cond)
- X (let ((matches-found nil))
- X (and (math-match-pattern expr lhs)
- X (or (null cond)
- X (math-is-true (math-simplify (math-replace-variables cond))))
- X (math-replace-variables rhs)))
- X)
- X
- X(defun math-apply-rewrite-rules (expr rules)
- X (let ((r rules)
- X next)
- X (while (and r
- X (or (not (setq next (math-apply-rewrite expr
- X (nth 1 (car r))
- X (nth 2 (car r))
- X (nth 3 (car r)))))
- X (equal expr (setq next (math-normalize next)))))
- X (setq r (cdr r)))
- X (and r
- X next))
- X)
- X
- X(defun math-rewrite (expr rules &optional many)
- X (setq rules (math-check-rewrite-rules rules))
- X (math-map-tree (function (lambda (x) (math-apply-rewrite-rules x rules)))
- X expr many)
- X)
- X
- X(defun math-check-rewrite-rules (rules)
- X (if (and (eq (car-safe rules) 'var)
- X (boundp (nth 2 rules))
- X (symbol-value (nth 2 rules)))
- X (setq rules (symbol-value (nth 2 rules))))
- X (or (Math-vectorp rules)
- X (error "Rules must be a vector"))
- X (setq rules (if (Math-vectorp (nth 1 rules))
- X (cdr rules)
- X (list rules)))
- X (let ((r rules))
- X (while r
- X (or (and (Math-vectorp (car r))
- X (cdr (cdr (car r)))
- X (not (nthcdr 4 (car r))))
- X (error "Malformed rules vector"))
- X (setq r (cdr r))))
- X rules
- X)
- X
- X(defun math-match-pattern (expr pat)
- X (cond ((Math-primp pat)
- X (or (math-equal expr pat)
- X (and (eq (car-safe pat) 'var)
- X (let ((match (assq (nth 1 pat) matches-found)))
- X (if match
- X (equal expr (nth 1 match))
- X (setq matches-found (cons (list (nth 1 pat)
- X expr)
- X matches-found)))))))
- X ((eq (car pat) 'calcFunc-quote)
- X (equal expr (nth 1 pat)))
- X (t
- X (and (eq (car pat) (car-safe expr))
- X (progn
- X (while (and (setq expr (cdr expr) pat (cdr pat))
- X expr
- X (math-match-pattern (car expr) (car pat))))
- X (and (null expr) (null pat))))))
- X)
- X
- X(defun math-replace-variables (expr)
- X (if (Math-primp expr)
- X (if (eq (car-safe expr) 'var)
- X (let ((match (assq (nth 1 expr) matches-found)))
- X (if match
- X (nth 1 match)
- X expr))
- X expr)
- X (cons (car expr) (mapcar 'math-replace-variables (cdr expr))))
- X)
- X
- X(defun math-is-true (expr)
- X (and (Math-realp expr)
- X (not (Math-zerop expr)))
- X)
- X
- X
- X
- X
- X(defun math-derivative (expr) ; uses global values: deriv-var, deriv-total.
- X (cond ((equal expr deriv-var)
- X 1)
- X ((or (Math-scalarp expr)
- X (eq (car expr) 'sdev)
- X (and (eq (car expr) 'var)
- X (not deriv-total)))
- X 0)
- X ((eq (car expr) '+)
- X (math-add (math-derivative (nth 1 expr))
- X (math-derivative (nth 2 expr))))
- X ((eq (car expr) '-)
- X (math-sub (math-derivative (nth 1 expr))
- X (math-derivative (nth 2 expr))))
- X ((eq (car expr) 'neg)
- X (math-neg (math-derivative (nth 1 expr))))
- X ((eq (car expr) '*)
- X (math-add (math-mul (nth 2 expr)
- X (math-derivative (nth 1 expr)))
- X (math-mul (nth 1 expr)
- X (math-derivative (nth 2 expr)))))
- X ((eq (car expr) '/)
- X (math-sub (math-div (math-derivative (nth 1 expr))
- X (nth 2 expr))
- X (math-div (math-mul (nth 1 expr)
- X (math-derivative (nth 2 expr)))
- X (math-sqr (nth 2 expr)))))
- X ((eq (car expr) '^)
- X (let ((du (math-derivative (nth 1 expr)))
- X (dv (math-derivative (nth 2 expr))))
- X (or (Math-zerop du)
- X (setq du (math-mul (nth 2 expr)
- X (math-mul (math-normalize
- X (list '^
- X (nth 1 expr)
- X (math-add (nth 2 expr) -1)))
- X du))))
- X (or (Math-zerop dv)
- X (setq dv (math-mul (math-normalize
- X (list 'calcFunc-ln (nth 1 expr)))
- X (math-mul expr dv))))
- X (math-add du dv)))
- X ((eq (car expr) '%)
- X (math-derivative (nth 1 expr))) ; a reasonable definition
- X ((eq (car expr) 'vec)
- X (math-map-vec 'math-derivative expr))
- X ((and (eq (car expr) 'calcFunc-log)
- X (= (length expr) 3)
- X (not (Math-zerop (nth 2 expr))))
- X (let ((lnv (math-normalize (list 'calcFunc-ln (nth 2 expr)))))
- X (math-sub (math-div (math-derivative (nth 1 expr))
- X (math-mul lnv (nth 1 expr)))
- X (math-div (math-derivative (nth 2 expr))
- X (math-mul (math-sqr lnv)
- X (nth 2 expr))))))
- X (t (or (and (= (length expr) 2)
- X (symbolp (car expr))
- X (let ((handler (get (car expr) 'math-derivative)))
- X (and handler
- X (let ((deriv (math-derivative (nth 1 expr))))
- X (if (Math-zerop deriv)
- X deriv
- X (math-mul (funcall handler (nth 1 expr))
- X deriv))))))
- X (if deriv-symb
- X (throw 'math-deriv nil)
- X (if (or (Math-objvecp expr)
- X (not (symbolp (car expr))))
- X (list (if deriv-total 'calcFunc-tderiv 'calcFunc-deriv)
- X expr
- X deriv-var)
- X (let ((accum 0)
- X (arg expr)
- X (n 1)
- X derv)
- X (while (setq arg (cdr arg))
- X (or (Math-zerop (setq derv (math-derivative (car arg))))
- X (let ((func (intern (concat (symbol-name (car expr))
- X "'"
- X (if (> n 1)
- X (int-to-string n)
- X "")))))
- X (setq accum (math-add
- X accum
- X (math-mul derv
- X (cons func
- X (cdr expr)))))))
- X (setq n (1+ n)))
- X accum))))))
- X)
- X
- X(defun calcFunc-deriv (expr deriv-var &optional deriv-value deriv-symb)
- X (let* ((deriv-total nil)
- X (res (catch 'math-deriv (math-derivative expr))))
- X (or (eq (car-safe res) 'calcFunc-deriv)
- X (null res)
- X (setq res (math-normalize res)))
- X (and res
- X (if deriv-value
- X (math-expr-subst res deriv-var deriv-value)
- X res)))
- X)
- X
- X(defun calcFunc-tderiv (expr deriv-var &optional deriv-value deriv-symb)
- X (let* ((deriv-total t)
- X (res (catch 'math-deriv (math-derivative expr))))
- X (or (eq (car-safe res) 'calcFunc-tderiv)
- X (null res)
- X (setq res (math-normalize res)))
- X (and res
- X (if deriv-value
- X (math-expr-subst res deriv-var deriv-value)
- X res)))
- X)
- X
- X(put 'calcFunc-inv 'math-derivative
- X (function (lambda (u) (math-neg (math-div 1 (math-sqr u))))))
- X
- X(put 'calcFunc-sqrt 'math-derivative
- X (function (lambda (u) (math-div 1 (math-mul 2 (list 'calcFunc-sqrt u))))))
- X
- X(put 'calcFunc-conj 'math-derivative
- X (function (lambda (u) (math-normalize (list 'calcFunc-conj u)))))
- X
- X(put 'calcFunc-deg 'math-derivative
- X (function (lambda (u) (math-div (math-pi-over-180) u))))
- X
- X(put 'calcFunc-rad 'math-derivative
- X (function (lambda (u) (math-mul (math-pi-over-180) u))))
- X
- X(put 'calcFunc-ln 'math-derivative
- X (function (lambda (u) (math-div 1 u))))
- X
- X(put 'calcFunc-log10 'math-derivative
- X (function (lambda (u)
- X (math-div (math-div 1 (math-normalize '(calcFunc-ln 10)))
- X u))))
- X
- X(put 'calcFunc-lnp1 'math-derivative
- X (function (lambda (u) (math-div 1 (math-add u 1)))))
- X
- X(put 'calcFunc-exp 'math-derivative
- X (function (lambda (u) (math-normalize (list 'calcFunc-exp u)))))
- X
- X(put 'calcFunc-expm1 'math-derivative
- X (function (lambda (u) (math-normalize (list 'calcFunc-expm1 u)))))
- X
- X(put 'calcFunc-sin 'math-derivative
- X (function (lambda (u) (math-to-radians-2 (math-normalize
- X (list 'calcFunc-cos u))))))
- X
- X(put 'calcFunc-cos 'math-derivative
- X (function (lambda (u) (math-neg (math-to-radians-2
- X (math-normalize
- X (list 'calcFunc-sin u)))))))
- X
- X(put 'calcFunc-tan 'math-derivative
- X (function (lambda (u) (math-to-radians-2
- X (math-div 1 (math-sqr
- X (math-normalize
- X (list 'calcFunc-cos u))))))))
- X
- X(put 'calcFunc-arcsin 'math-derivative
- X (function (lambda (u)
- X (math-from-radians-2
- X (math-div 1 (math-normalize
- X (list 'calcFunc-sqrt
- X (math-sub 1 (math-sqr u)))))))))
- X
- X(put 'calcFunc-arccos 'math-derivative
- X (function (lambda (u)
- X (math-from-radians-2
- X (math-div -1 (math-normalize
- X (list 'calcFunc-sqrt
- X (math-sub 1 (math-sqr u)))))))))
- X
- X(put 'calcFunc-arctan 'math-derivative
- X (function (lambda (u) (math-from-radians-2
- X (math-div 1 (math-add 1 (math-sqr u)))))))
- X
- X(put 'calcFunc-sinh 'math-derivative
- X (function (lambda (u) (math-normalize (list 'calcFunc-cosh u)))))
- X
- X(put 'calcFunc-cosh 'math-derivative
- X (function (lambda (u) (math-normalize (list 'calcFunc-sinh u)))))
- X
- X(put 'calcFunc-tanh 'math-derivative
- X (function (lambda (u) (math-div 1 (math-sqr
- X (math-normalize
- X (list 'calcFunc-cosh u)))))))
- X
- X(put 'calcFunc-arcsinh 'math-derivative
- X (function (lambda (u)
- X (math-div 1 (math-normalize
- X (list 'calcFunc-sqrt
- X (math-add (math-sqr u) 1)))))))
- X
- X(put 'calcFunc-arccosh 'math-derivative
- X (function (lambda (u)
- X (math-div 1 (math-normalize
- X (list 'calcFunc-sqrt
- X (math-add (math-sqr u) -1)))))))
- X
- X(put 'calcFunc-arctanh 'math-derivative
- X (function (lambda (u) (math-div 1 (math-sub 1 (math-sqr u))))))
- X
- X
- X
- X(setq math-integ-var '(var X ---))
- X(setq math-integ-var-2 '(var Y ---))
- X(setq math-integ-vars (list 'f math-integ-var math-integ-var-2))
- X
- X(defmacro math-tracing-integral (&rest parts)
- X (list 'and
- X 'trace-buffer
- X (list 'save-excursion
- X '(set-buffer trace-buffer)
- X '(goto-char (point-max))
- X (list 'and
- X '(bolp)
- X '(insert (make-string (- calc-integral-limit
- X math-integ-level) 32)
- X (format "%2d " math-integ-depth)
- X (make-string math-integ-level 32)))
- X (cons 'insert parts)
- X '(sit-for 0)))
- X)
- X
- X;;; The following wrapper caches results and avoids infinite recursion.
- X;;; Each cache entry is: ( A B ) Integral of A is B;
- X;;; ( A N ) Integral of A failed at level N;
- X;;; ( A busy ) Currently working on integral of A;
- X;;; ( A parts ) Currently working, integ-by-parts;
- X;;; ( A parts2 ) Currently working, integ-by-parts;
- X;;; ( A cancelled ) Ignore this cache entry;
- X;;; ( A [B] ) Same result as for cur-record = B.
- X(defun math-integral (expr &optional simplify same-as-above)
- X (let* ((simp cur-record)
- X (cur-record (assoc expr math-integral-cache))
- X (math-integ-depth (1+ math-integ-depth))
- X (val 'cancelled))
- X (math-tracing-integral "Integrating "
- X (math-format-value expr 1000)
- X "...\n")
- X (and cur-record
- X (progn
- X (math-tracing-integral "Found "
- X (math-format-value (nth 1 cur-record) 1000))
- X (and (consp (nth 1 cur-record))
- X (math-replace-integral-parts cur-record))
- X (math-tracing-integral " => "
- X (math-format-value (nth 1 cur-record) 1000)
- X "\n")))
- X (or (and cur-record
- X (not (eq (nth 1 cur-record) 'cancelled))
- X (or (not (integerp (nth 1 cur-record)))
- X (>= (nth 1 cur-record) math-integ-level)))
- X (and (consp expr)
- X (eq (car expr) 'var)
- X (eq (nth 1 expr) 'PARTS)
- X (listp (nth 2 expr))
- X (progn
- X (setq val nil)
- X t))
- X (unwind-protect
- X (progn
- X (let (math-integ-msg)
- X (if (eq calc-display-working-message 'lots)
- X (progn
- X (calc-set-command-flag 'clear-message)
- X (setq math-integ-msg (format
- X "Working... Integrating %s"
- X (math-format-flat-expr expr 0)))
- X (message math-integ-msg)))
- X (if cur-record
- X (setcar (cdr cur-record)
- X (if same-as-above (vector simp) 'busy))
- X (setq cur-record
- X (list expr (if same-as-above (vector simp) 'busy))
- X math-integral-cache (cons cur-record
- X math-integral-cache)))
- X (if (eq simplify 'yes)
- X (progn
- X (math-tracing-integral "Simplifying...")
- X (setq simp (math-simplify expr))
- X (setq val (if (equal simp expr)
- X (progn
- X (math-tracing-integral " no change\n")
- X (math-do-integral expr))
- X (math-tracing-integral " simplified\n")
- X (math-integral simp 'no t))))
- X (or (setq val (math-do-integral expr))
- X (eq simplify 'no)
- X (let ((simp (math-simplify expr)))
- X (or (equal simp expr)
- X (progn
- X (math-tracing-integral "Trying again after "
- X "simplification...\n")
- X (setq val (math-integral simp 'no t))))))))
- X (if (eq calc-display-working-message 'lots)
- X (message math-integ-msg)))
- X (setcar (cdr cur-record) (or val math-integ-level))))
- X (setq val cur-record)
- X (while (vectorp (nth 1 val))
- X (setq val (aref (nth 1 val) 0)))
- X (setq val (if (memq (nth 1 val) '(parts parts2))
- X (progn
- X (setcar (cdr val) 'parts2)
- X (list 'var 'PARTS val))
- X (and (not (eq (nth 1 val) 'busy))
- X (not (integerp (nth 1 val)))
- X (nth 1 val))))
- X (math-tracing-integral "Integral of "
- X (math-format-value expr 1000)
- X " is "
- X (math-format-value val 1000)
- X "\n")
- X val)
- X)
- X(defvar math-integral-cache nil)
- X(defvar math-integral-cache-state nil)
- X
- X(defun math-replace-integral-parts (expr)
- X (or (Math-primp expr)
- X (while (setq expr (cdr expr))
- X (and (consp (car expr))
- X (if (eq (car (car expr)) 'var)
- X (and (eq (nth 1 (car expr)) 'PARTS)
- X (consp (nth 2 (car expr)))
- X (if (listp (nth 1 (nth 2 (car expr))))
- X (progn
- X (setcar expr (nth 1 (nth 2 (car expr))))
- X (math-replace-integral-parts (cons 'foo expr)))
- X (setcar (cdr cur-record) 'cancelled)))
- X (math-replace-integral-parts (car expr))))))
- X)
- X
- X(defun math-do-integral (expr)
- X (let (t1 t2)
- X (or (cond ((not (math-expr-contains expr math-integ-var))
- X (math-mul expr math-integ-var))
- X ((equal expr math-integ-var)
- X (math-div (math-sqr expr) 2))
- X ((eq (car expr) '+)
- X (and (setq t1 (math-integral (nth 1 expr)))
- X (setq t2 (math-integral (nth 2 expr)))
- X (math-add t1 t2)))
- X ((eq (car expr) '-)
- X (and (setq t1 (math-integral (nth 1 expr)))
- X (setq t2 (math-integral (nth 2 expr)))
- X (math-sub t1 t2)))
- X ((eq (car expr) 'neg)
- X (and (setq t1 (math-integral (nth 1 expr)))
- X (math-neg t1)))
- X ((eq (car expr) '*)
- X (cond ((not (math-expr-contains (nth 1 expr) math-integ-var))
- X (and (setq t1 (math-integral (nth 2 expr)))
- X (math-mul (nth 1 expr) t1)))
- X ((not (math-expr-contains (nth 2 expr) math-integ-var))
- X (and (setq t1 (math-integral (nth 1 expr)))
- X (math-mul t1 (nth 2 expr))))
- X ((memq (car-safe (nth 1 expr)) '(+ -))
- X (math-integral (list (car (nth 1 expr))
- X (math-mul (nth 1 (nth 1 expr))
- X (nth 2 expr))
- X (math-mul (nth 2 (nth 1 expr))
- X (nth 2 expr)))
- X 'yes t))
- X ((memq (car-safe (nth 2 expr)) '(+ -))
- X (math-integral (list (car (nth 2 expr))
- X (math-mul (nth 1 (nth 2 expr))
- X (nth 1 expr))
- X (math-mul (nth 2 (nth 2 expr))
- X (nth 1 expr)))
- X 'yes t))))
- X ((eq (car expr) '/)
- X (cond ((not (math-expr-contains (nth 2 expr) math-integ-var))
- X (and (setq t1 (math-integral (nth 1 expr)))
- X (math-div t1 (nth 2 expr))))
- X ((and (eq (car-safe (nth 1 expr)) '*)
- X (not (math-expr-contains (nth 1 (nth 1 expr))
- X math-integ-var)))
- X (and (setq t1 (math-integral
- X (math-div (nth 2 (nth 1 expr))
- X (nth 2 expr))))
- X (math-mul t1 (nth 1 (nth 1 expr)))))
- X ((and (eq (car-safe (nth 2 expr)) '*)
- X (not (math-expr-contains (nth 1 (nth 2 expr))
- X math-integ-var)))
- X (and (setq t1 (math-integral
- X (math-div (nth 1 expr)
- X (nth 2 (nth 2 expr)))))
- X (math-div t1 (nth 1 (nth 2 expr)))))
- X ((memq (car-safe (nth 1 expr)) '(+ -))
- X (math-integral (list (car (nth 1 expr))
- X (math-div (nth 1 (nth 1 expr))
- X (nth 2 expr))
- X (math-div (nth 2 (nth 1 expr))
- X (nth 2 expr)))
- X 'yes t))))
- X ((eq (car expr) '^)
- X (cond ((not (math-expr-contains (nth 1 expr) math-integ-var))
- X (or (and (setq t1 (math-is-polynomial (nth 2 expr)
- X math-integ-var 1))
- X (math-div expr
- X (math-mul (nth 1 t1)
- X (math-normalize
- X (list 'calcFunc-ln
- X (nth 1 expr))))))
- X (math-integral
- X (list 'calcFunc-exp
- X (math-mul (nth 2 expr)
- X (math-normalize
- X (list 'calcFunc-ln
- X (nth 1 expr)))))
- X 'yes t)))
- X ((not (math-expr-contains (nth 2 expr) math-integ-var))
- X (if (Math-equal-int (nth 2 expr) -1)
- X (math-integral (math-div 1 (nth 1 expr)) nil t)
- X (or (and (setq t1 (math-is-polynomial (nth 1 expr)
- X math-integ-var
- X 1))
- X (setq t2 (math-add (nth 2 expr) 1))
- X (math-div (math-pow (nth 1 expr) t2)
- X (math-mul t2 (nth 1 t1))))
- X (and (Math-negp (nth 2 expr))
- X (math-integral
- X (math-div 1
- X (math-pow (nth 1 expr)
- X (math-neg
- X (nth 2 expr))))
- X nil t))
- X nil))))))
- X
- X ;; Integral of a polynomial.
- X (and (setq t1 (math-is-polynomial expr math-integ-var 20))
- X (let ((accum 0)
- X (n 1))
- X (while t1
- X (if (setq accum (math-add accum
- X (math-div (math-mul (car t1)
- X (math-pow
- X math-integ-var
- X n))
- X n))
- X t1 (cdr t1))
- X (setq n (1+ n))))
- X accum))
- X
- X ;; Try looking it up!
- X (cond ((= (length expr) 2)
- X (and (symbolp (car expr))
- X (setq t1 (get (car expr) 'math-integral))
- X (progn
- X (while (and t1
- X (not (setq t2 (funcall (car t1)
- X (nth 1 expr)))))
- X (setq t1 (cdr t1)))
- X (and t2 (math-normalize t2)))))
- X ((= (length expr) 3)
- X (and (symbolp (car expr))
- X (setq t1 (get (car expr) 'math-integral-2))
- X (progn
- X (while (and t1
- X (not (setq t2 (funcall (car t1)
- X (nth 1 expr)
- X (nth 2 expr)))))
- X (setq t1 (cdr t1)))
- X (and t2 (math-normalize t2))))))
- X
- X ;; Integration by substitution, for various likely sub-expressions.
- X ;; (We should also try some of the classic non-obvious substitutions.)
- X (let ((so-far nil))
- X (math-integ-try-substitutions expr))
- X
- X ;; Integration by parts:
- X ;; integ(f(x) g(x),x) = f(x) h(x) - integ(h(x) f'(x),x)
- X ;; where h(x) = integ(g(x),x).
- X (and (eq (car expr) '*)
- X (not (math-polynomial-p (nth 2 expr) math-integ-var))
- X (math-integrate-by-parts (nth 1 expr) (nth 2 expr)))
- X (and (eq (car expr) '/)
- X (math-expr-contains (nth 1 expr) math-integ-var)
- X (let ((recip (math-div 1 (nth 2 expr))))
- X (or (math-integrate-by-parts (nth 1 expr) recip)
- X (math-integrate-by-parts recip (nth 1 expr)))))
- X (and (eq (car expr) '^)
- X (math-integrate-by-parts (nth 1 expr)
- X (math-pow (nth 1 expr)
- X (math-sub (nth 2 expr) 1))))
- X
- X ;; Symmetries.
- X (and (eq (car expr) '*)
- X (math-integral (list '* (nth 2 expr) (nth 1 expr)) 'no t))
- X
- X ;; Give up.
- X nil))
- X)
- X
- X(defun math-integrate-by-parts (u vprime)
- X (and (> math-integ-level 0)
- X (not (boundp 'math-disable-parts))
- X (let ((math-integ-level (1- math-integ-level))
- X v temp)
- X (unwind-protect
- X (progn
- X (setcar (cdr cur-record) 'parts)
- X (math-tracing-integral "Integrating by parts, u = "
- X (math-format-value u 1000)
- X ", v' = "
- X (math-format-value vprime 1000)
- X "\n")
- X (and (setq v (math-integral vprime))
- X (setq temp (calcFunc-deriv u
- X math-integ-var
- X nil t))
- X (setq temp (math-integral (math-mul v temp) 'yes))
- X (setq temp (math-sub (math-mul u v) temp))
- X (if (eq (nth 1 cur-record) 'parts)
- X temp
- X (setq v (list 'var 'PARTS cur-record)
- X temp (math-solve-for (math-sub v temp) 0 v nil))
- X (and temp (math-simplify-extended temp)))))
- X (setcar (cdr cur-record) 'busy))))
- X)
- X
- X;;; This tries two different formulations, hoping the algebraic simplifier
- X;;; will be strong enough to handle at least one.
- X(defun math-integrate-by-substitution (expr u)
- X (and (> math-integ-level 0)
- X (let ((math-integ-level (1- math-integ-level))
- X (math-living-dangerously t)
- X uinv deriv temp)
- X (and (setq uinv (math-solve-for u
- X math-integ-var-2
- X math-integ-var nil))
- X (progn
- X (math-tracing-integral "Integrating by substitution, u = "
- X (math-format-value u 1000)
- X "\n")
- X (or (and (not (boundp 'math-disable-subst1))
- X (setq deriv (calcFunc-deriv u
- X math-integ-var nil t))
- X (setq temp (math-integral (math-expr-subst
- X (math-expr-subst
- X (math-expr-subst
- X (math-div expr deriv)
- X u
- X math-integ-var-2)
- X math-integ-var
- X uinv)
- X math-integ-var-2
- X math-integ-var)
- X 'yes)))
- X (and (not (boundp 'math-disable-subst2))
- X (setq deriv (calcFunc-deriv uinv
- X math-integ-var-2
- X math-integ-var t))
- X (setq temp (math-integral (math-mul
- X (math-expr-subst
- X (math-expr-subst
- X (math-expr-subst
- X expr
- X u
- X math-integ-var-2)
- X math-integ-var
- X uinv)
- X math-integ-var-2
- X math-integ-var)
- X deriv)
- X 'yes)))))
- X (math-simplify-extended
- X (math-expr-subst temp math-integ-var u)))))
- X)
- X
- X;;; Recursively try different substitutions based on various sub-expressions.
- X(defun math-integ-try-substitutions (sub-expr)
- X (and (not (Math-primp sub-expr))
- X (math-expr-contains sub-expr math-integ-var)
- X (not (equal sub-expr math-integ-var))
- X (not (assoc sub-expr so-far))
- X (or (and (not (eq sub-expr expr))
- X (math-integrate-by-substitution expr sub-expr))
- X (let ((res nil))
- X (setq so-far (cons (list sub-expr) so-far))
- X (while (and (setq sub-expr (cdr sub-expr))
- X (not (setq res (math-integ-try-substitutions
- X (car sub-expr))))))
- X res)))
- X)
- X
- X(defun math-fix-const-terms (expr except-vars)
- X (cond ((not (math-expr-depends expr except-vars)) 0)
- X ((Math-primp expr) expr)
- X ((eq (car expr) '+)
- X (math-add (math-fix-const-terms (nth 1 expr) except-vars)
- X (math-fix-const-terms (nth 2 expr) except-vars)))
- X ((eq (car expr) '-)
- X (math-sub (math-fix-const-terms (nth 1 expr) except-vars)
- X (math-fix-const-terms (nth 2 expr) except-vars)))
- X (t expr))
- X)
- X
- X(defun calc-dump-integral-cache (&optional arg)
- X "Command for debugging the Calculator's symbolic integrator."
- X (interactive "P")
- X (let ((buf (current-buffer)))
- X (unwind-protect
- X (let ((p math-integral-cache)
- X cur-record)
- X (display-buffer (get-buffer-create "*Integral Cache*"))
- X (set-buffer (get-buffer "*Integral Cache*"))
- X (erase-buffer)
- X (while p
- X (setq cur-record (car p))
- X (or arg (math-replace-integral-parts cur-record))
- X (insert (math-format-flat-expr (car cur-record) 0)
- X " --> "
- X (if (symbolp (nth 1 cur-record))
- X (concat "(" (symbol-name (nth 1 cur-record)) ")")
- X (math-format-flat-expr (nth 1 cur-record) 0))
- X "\n")
- X (setq p (cdr p)))
- X (goto-char (point-min)))
- X (set-buffer buf)))
- X)
- X
- X(defun calcFunc-integ (expr var &optional low high)
- X (let ((state (list calc-angle-mode
- X calc-symbolic-mode
- X calc-prefer-frac
- X calc-internal-prec)))
- X (or (equal state math-integral-cache-state)
- X (setq math-integral-cache-state state
- X math-integral-cache nil)))
- X (let* ((math-integ-level calc-integral-limit)
- X (math-integ-depth 0)
- X (math-integ-msg "Working...done")
- X (cur-record nil) ; a technicality
- X (sexpr (math-expr-subst expr var math-integ-var))
- X (trace-buffer (get-buffer "*Trace*"))
- X (calc-language (if (eq calc-language 'big) nil calc-language))
- X (res (if trace-buffer
- X (let ((calcbuf (current-buffer))
- X (calcwin (selected-window)))
- X (unwind-protect
- X (progn
- X (if (get-buffer-window trace-buffer)
- X (select-window (get-buffer-window trace-buffer)))
- X (set-buffer trace-buffer)
- X (goto-char (point-max))
- X (or (assq 'scroll-stop (buffer-local-variables))
- X (progn
- X (make-local-variable 'scroll-step)
- X (setq scroll-step 3)))
- X (insert "\n\n\n")
- X (set-buffer calcbuf)
- X (math-integral sexpr 'yes))
- X (select-window calcwin)
- X (set-buffer calcbuf)))
- X (math-integral sexpr 'yes))))
- X (if res
- X (math-normalize
- X (if (and low high)
- X (math-sub (math-expr-subst res math-integ-var high)
- X (math-expr-subst res math-integ-var low))
- X (setq res (math-fix-const-terms res math-integ-vars))
- X (if low
- X (math-expr-subst res math-integ-var low)
- X (math-expr-subst res math-integ-var var))))
- X (append (list 'calcFunc-integ expr var)
- X (and low (list low))
- X (and high (list high)))))
- X)
- X
- X(defmacro math-defintegral (funcs &rest code)
- X "Define an integration rule for the specified function.
- XIf FUNCS is a list of functions, the same rule is applied for each function.
- XCODE is a body of Lisp code that returns the integral of FUNCS(U).
- XMore than one definition may be made per function. All definitions are tried
- Xin the order they were encountered; the first non-NIL value returned is used."
- X (setq math-integral-cache nil)
- X (append '(progn)
- X (mapcar (function
- X (lambda (func)
- X (list 'put (list 'quote func) ''math-integral
- X (list 'nconc
- X (list 'get (list 'quote func) ''math-integral)
- X (list 'list
- X (list 'function
- X (append '(lambda (u))
- X code)))))))
- X (if (symbolp funcs) (list funcs) funcs)))
- X)
- X(put 'math-defintegral 'lisp-indent-hook 1)
- X
- X(defmacro math-defintegral-2 (funcs &rest code)
- X "Define an integration rule for the specified function.
- XIf FUNCS is a list of functions, the same rule is applied for each function.
- XCODE is a body of Lisp code that returns the integral of FUNCS(U,V).
- XMore than one definition may be made per function. All definitions are tried
- Xin the order they were encountered; the first non-NIL value returned is used."
- X (setq math-integral-cache nil)
- X (append '(progn)
- X (mapcar (function
- X (lambda (func)
- X (list 'put (list 'quote func) ''math-integral-2
- X (list 'nconc
- X (list 'get (list 'quote func)
- SHAR_EOF
- echo "End of part 9"
- echo "File calc-ext.el is continued in part 10"
- echo "10" > s2_seq_.tmp
- exit 0
-